home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / sierpinski.scm < prev    next >
Text File  |  1999-04-19  |  2KB  |  72 lines
  1. ;"sierpinski.scm" Hash function for 2d data which preserves nearness.
  2. ;From: jjb@isye.gatech.edu (John Bartholdi)
  3. ;
  4. ; This code is in the public domain.
  5.  
  6. ;Date: Fri, 6 May 94 13:22:34 -0500
  7.  
  8. (define MAKE-SIERPINSKI-INDEXER
  9.   (lambda (max-coordinate)
  10.     (lambda (x y)
  11.       (if (not (and (<= 0 x max-coordinate)
  12.             (<= 0 y max-coordinate)))
  13.       (slib:error 'sierpinski-index 
  14.          "Coordinate exceeds specified maximum.")
  15.       ;
  16.       ; The following two mutually recursive procedures
  17.       ; correspond to to partitioning successive triangles
  18.       ; into two sub-triangles, adjusting the index according
  19.       ; to which sub-triangle (x,y) lies in, then rescaling
  20.       ; and possibly rotating to continue the recursive
  21.       ; decomposition:
  22.       ;
  23.       (letrec ((loopA
  24.             (lambda (resolution x y index)
  25.               (cond ((zero? resolution) index)
  26.                 (else
  27.                  (let ((finer-index (+ index index)))
  28.                    (if (> (+ x y) max-coordinate)
  29.                    ;
  30.                    ; In the upper sub-triangle:
  31.                    (loopB resolution
  32.                       (- max-coordinate y)
  33.                       x
  34.                       (+ 1 finer-index))
  35.                    ;
  36.                    ; In the lower sub-triangle:
  37.                    (loopB resolution
  38.                       x
  39.                       y
  40.                       finer-index)))))))
  41.            (loopB
  42.             (lambda (resolution x y index)
  43.               (let ((new-x (+ x x))
  44.                 (new-y (+ y y))
  45.                 (finer-index (+ index index)))
  46.             (if (> new-y max-coordinate)
  47.                 ;
  48.                 ; In the upper sub-triangle:
  49.                 (loopA (quotient resolution 2)
  50.                    (- new-y max-coordinate)
  51.                    (- max-coordinate new-x)
  52.                    (+ finer-index 1))
  53.                 ;
  54.                 ; In the lower sub-triangle:
  55.                 (loopA (quotient resolution 2)
  56.                    new-x
  57.                    new-y
  58.                    finer-index))))))
  59.         (if (<= x y)
  60.         ;
  61.         ; Point in NW triangle of initial square:
  62.         (loopA max-coordinate
  63.                x
  64.                y
  65.                0)
  66.         ;
  67.         ; Else point in SE triangle of initial square
  68.         ; so translate point and increase index:
  69.         (loopA max-coordinate
  70.                (- max-coordinate x)
  71.                (- max-coordinate y) 1)))))))
  72.